home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor1 / fourier.src < prev    next >
Text File  |  1990-10-18  |  3KB  |  111 lines
  1. %%HP: T(3)A(D)F(.);
  2. @ by Robert W Yoder.
  3. DIR
  4.   DFT
  5.     \<< SWAP DUP SIZE 1 GET \pi \->NUM (0,-2) * OVER / 4 PICK * \-> d x s q
  6.       \<< 0 s 1 -
  7.         FOR k 0 0 s 1 -
  8.           FOR n q k * n * EXP x n 1 + GET * +
  9.           NEXT
  10.         NEXT s \->ARRY
  11.         IF d -1 SAME
  12.         THEN s INV *
  13.         END
  14.       \>>
  15.     \>>
  16.   FFT
  17.     \<< ARRY\-> 1 GET
  18.       IF DUP LN 2 LN / DUP IP ==
  19.       THEN \-> t
  20.         \<< 1 t LN 2 LN /
  21.           FOR c -2 \pi * i * 2 c ^ / EXP \->NUM 2 c 1 - ^ \-> f k
  22.             \<< t 2 / 1 + t
  23.               FOR d 0 k 1 - FOR e t ROLL d e + ROLL f e ^ * - LASTARG + e 2 +
  24.                 ROLLD NEXT k
  25.               STEP
  26.             \>>
  27.           NEXT t \->ARRY
  28.         \>>
  29.       ELSE \->ARRY "FFT Error: Size \=/ 2^N" 1 DISP 1400 .07 BEEP
  30.       END
  31.     \>>
  32.   FFTI
  33.     \<< CONJ FFT DUP SIZE 1 GET / CONJ
  34.     \>>
  35.   FT
  36.     \<< DUP SIZE 1 GET
  37.       IF LN 2 LN / FP
  38.       THEN 1 DFT
  39.       ELSE FFT
  40.       END -10 RND
  41.     \>>
  42.   INVFT
  43.     \<< DUP SIZE 1 GET
  44.       IF LN 2 LN / FP
  45.       THEN -1 DFT
  46.       ELSE FFTI
  47.       END -10 RND
  48.     \>>
  49.   PCNV
  50.     \<< FT SWAP FT \-> a b
  51.       \<< a SIZE 1 GET \-> s
  52.         \<< 1 s
  53.           FOR n a n GET b n GET *
  54.           NEXT s \->ARRY
  55.         \>>
  56.       \>> INVFT
  57.     \>>
  58.   APCNV
  59.     \<< \-> a b
  60.       \<< a SIZE 1 GET b SIZE 1 GET + 1 - 1 \->LIST \-> s
  61.         \<< a s RDM b s RDM
  62.         \>>
  63.       \>> PCNV
  64.     \>>
  65.   FFT2
  66.     \<< DUP SIZE LIST\-> DROP \-> a nr nc
  67.       \<< "[" 1 nr
  68.         FOR r 1 nc
  69.           FOR c 'a(r,c)' \->NUM
  70.           NEXT nc \->ARRY FT \->STR +
  71.         NEXT STR\-> 'a' STO "[" 1 nc
  72.         FOR c 1 nr
  73.           FOR r 'a(r,c)' \->NUM
  74.           NEXT nr \->ARRY FT \->STR +
  75.         NEXT STR\-> TRN CONJ
  76.       \>>
  77.     \>>
  78.   IFFT2
  79.     \<< DUP SIZE LIST\-> DROP \-> a nr nc
  80.       \<< "[" 1 nc
  81.         FOR c 1 nr
  82.           FOR r 'a(r,c)' \->NUM
  83.           NEXT nr \->ARRY INVFT \->STR +
  84.         NEXT STR\-> TRN CONJ 'a' STO "[" 1 nr
  85.         FOR r 1 nc
  86.           FOR c 'a(r,c)' \->NUM
  87.           NEXT nc \->ARRY INVFT \->STR +
  88.         NEXT STR\->
  89.       \>>
  90.     \>>
  91.   FTSH
  92.     \<< DUP SIZE DUP LIST\-> DROP \-> a s rt ct
  93.       \<< rt 2 / DUP 1 + ct 2 / DUP 1 + \-> r2 r3 c2 c1
  94.         \<< r3 rt
  95.           FOR r c1 ct
  96.             FOR c 'a(r,c)' \->NUM
  97.             NEXT 1 c2
  98.             FOR c 'a(r,c)' \->NUM
  99.             NEXT
  100.           NEXT 1 r2
  101.           FOR r c1 ct
  102.             FOR c 'a(r,c)' \->NUM
  103.             NEXT 1 c2
  104.             FOR c 'a(r,c)' \->NUM
  105.             NEXT
  106.           NEXT s \->ARRY
  107.         \>>
  108.       \>>
  109.     \>>
  110. END
  111.